home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / demostuf / light1.pas < prev    next >
Pascal/Delphi Source File  |  1994-07-25  |  10KB  |  574 lines
  1. program lightsource1;
  2. {
  3.     Lightsourced (blenk, really) vector #1
  4.     - by Bjarke Viksφe
  5.     feb 1994
  6.  
  7.   THIS PROGRAM WAS CODED BY BJARKE VIKS0E.
  8.   YOU ARE FREE TO DO WHATEVER YOU WANT WITH THIS PIECE OF CODE.
  9.   E-MAIL ME AT: dat92230@rix02.lyngbyes.dk IN 1994 FOR CHAT AND CODE.
  10.  
  11.     Pretty basic. Rotate coords and draw polygons on screen. I use
  12.     a different polygon-drawing scheme that all other coders on PC I think.
  13.     Starting x-pos and ending x-pos are calculated for each horizontal
  14.     line of the whole polygon before it's drawn on the screen.
  15.     So we could technically do n-sided polygons just as easy.
  16.     Takes too long time because of erasing of screen before drawing.
  17.     Need to come up with some idea to skip that...
  18. }
  19.  
  20. {$DEFINE DEBUG}
  21.  
  22. uses
  23.     DEMOINIT;
  24.  
  25. const
  26.     ANTAL_FACES = 6;
  27.     ANTAL_COORDS = 8;
  28.     box = 140; {size of box}
  29.  
  30. type
  31.     facetype = RECORD
  32.         l1,l2,l3,l4 : byte;
  33.     end;
  34.  
  35. var
  36.     slope                    : array[0..399] of integer;
  37.     face                    : array[1..ANTAL_FACES] of facetype;
  38.     light                    : array[1..ANTAL_FACES] of byte;
  39.     cbuffer                : array[0..ANTAL_COORDS*2-1] of integer;
  40.  
  41.     miny,maxy             : integer;
  42.     scrminy,scrmaxy     : integer;
  43.     lastscrminy, lastscrmaxy : integer;
  44.  
  45.     sinustabel            : array[0..639] of integer;
  46.     v1,v2,v3                : word;
  47.     cos1,sin1,cos2,sin2,cos3,sin3 : integer;
  48.  
  49.     xkoord,ykoord,zkoord,
  50.     n : integer;
  51.  
  52.  
  53. const
  54.     display1 : integer = $0000;
  55.     display2 : integer = $4000;
  56.     coords : array[0..ANTAL_COORDS*3-1] of integer =
  57.         (box,box,-box, -box,box,-box, -box,-box,-box, box,-box,-box,
  58.         box,box,box, -box,box,box, -box,-box,box, box,-box,box);
  59.  
  60.  
  61. (*------------------------------------------------*)
  62.  
  63. procedure SetupSinus;
  64. var
  65.     i : integer;
  66.     v, vadd : real;
  67. begin
  68.     v:=0.0;
  69.     vadd:=(2.0*pi/512.0);
  70.     for i:=0 to 639 do begin
  71.         sinustabel[i]:=round(sin(v)*32767);
  72.         v:=v+vadd;
  73.     end;
  74. end;
  75.  
  76. procedure SetupCoords;
  77. begin
  78.     with face[1] do begin l1:=3; l2:=2; l3:=1; l4:=0; end;
  79.     with face[2] do begin l1:=4; l2:=5; l3:=6; l4:=7; end;
  80.     with face[3] do begin l1:=0; l2:=1; l3:=5; l4:=4; end;
  81.     with face[4] do begin l1:=1; l2:=2; l3:=6; l4:=5; end;
  82.     with face[5] do begin l1:=2; l2:=3; l3:=7; l4:=6; end;
  83.     with face[6] do begin l1:=3; l2:=0; l3:=4; l4:=7; end;
  84. end;
  85.  
  86. procedure InitDemo;
  87. var
  88.     i : integer;
  89. begin
  90.     Screen_Off;
  91.     ClearWholeScreen;
  92.     SetupSinus;
  93.     SetupCoords;
  94.  
  95.     scrminy := 0; scrmaxy := 200;
  96.     lastscrminy := 0; lastscrmaxy := 200;
  97.     v1:=0; v2:=0; v3:=0;
  98.     Screen_On;
  99. end;
  100.  
  101.  
  102. (*------------------------------------------------*)
  103.  
  104. procedure SwapDisplay;
  105. var
  106.     temp : word;
  107. begin
  108.     temp:=display2;
  109.     display2:=display1;
  110.     display1:=temp;
  111.     SetAddress(Ptr(SEGA000,display2));
  112. end;
  113.  
  114. procedure ClearScreen(y1,y2 : integer); assembler;
  115. asm
  116.     mov    dx,$3C4
  117.     mov    ax,$0F02
  118.     out    dx,ax
  119.  
  120.     mov    bx,y1        {clear box around vector - only y-coords are actually}
  121.     mov    dx,y2        {used for calculation... x-coords are constant}
  122.     sub    dx,bx
  123.     cmp    dx,200
  124.     ja        @done
  125.  
  126.     lea    si,ytabel
  127.     add    bx,bx
  128.     mov    di,[si+bx]
  129.     add    di,display1
  130.     add    di,16
  131.  
  132.     mov    es,SEGA000
  133.     DB LONG; xor ax,ax
  134.     mov    bx,48/4
  135. @loop:
  136.     mov    cx,bx
  137.     rep; DB LONG; stosw
  138.     add    di,WIDTH-48
  139.     dec    dl
  140.     jnz    @loop
  141. @done:
  142. end;
  143.  
  144.  
  145. (*------------------------------------------------*)
  146.  
  147. procedure ClearSlope; assembler;
  148. asm
  149.     mov    ax,ds
  150.     mov    es,ax
  151.     lea    di,slope
  152.     DB LONG; mov ax,$8000; DW $8000;
  153.     cld
  154.     mov    cx,200
  155.     rep; DB LONG; stosw
  156. end;
  157.  
  158. procedure CalcSlope(l1,l2 : integer); assembler;
  159. var
  160.     ysize : integer;
  161. asm
  162.     lea    si,cbuffer
  163.     mov    bx,l1
  164.     shl    bx,2
  165.     mov    cx,[si+bx]
  166.     mov    dx,[si+bx+2]
  167.     mov    bx,l2
  168.     shl    bx,2
  169.     add    si,bx
  170.     mov    ax,[si]
  171.     mov    bx,[si+2]
  172.  
  173.     cmp    bx,dx
  174.     jle    @noswap
  175.     xchg    ax,cx
  176.     xchg    bx,dx
  177. @noswap:
  178.     cmp    bx,miny
  179.     jae    @miny
  180.     mov    miny,bx
  181. @miny:
  182.     cmp    dx,maxy
  183.     jbe    @maxy
  184.     mov    maxy,dx
  185. @maxy:
  186.  
  187.     sub    dx,bx
  188.     mov    ysize,dx
  189.     add    bx,bx
  190.     add    bx,bx
  191.     lea    si,slope
  192.     add    si,bx
  193.  
  194.     push    ax
  195.     sub    cx,ax
  196.     inc    cx
  197.  
  198.     and    dx,dx
  199.     jz        @zero
  200.     cmp    dl,1
  201.     jne    @not1
  202.     dec    cx
  203.     mov    dx,cx
  204.     xor    ax,ax
  205.     jmp    NEAR PTR @one
  206. @not1:
  207.     cmp    dl,2
  208.     jne    @not2
  209.     mov    ax,$7FFF
  210.     imul    cx
  211.     jmp    NEAR PTR @one
  212. @not2:
  213.  
  214.     mov    dx,$0001
  215.     mov    ax,$0000
  216.     idiv    ysize
  217.     imul    cx
  218. @one:
  219.     pop    cx
  220.     xor    bx,bx
  221.  
  222.     mov    di,$8000
  223. @loop:
  224.     cmp    [si],di
  225.     jne    @other
  226.     mov    [si],cx
  227.     add    si,4
  228.     add    bx,ax
  229.     adc    cx,dx
  230.     dec    ysize
  231.     jnz    @loop
  232.     jmp    NEAR PTR @zero
  233. @other:
  234.     mov    [si+2],cx
  235.     add    si,4
  236.     add    bx,ax
  237.     adc    cx,dx
  238.     dec    ysize
  239.     jnz    @loop
  240. @zero:
  241. end;
  242.  
  243.  
  244. (*------------------------------------------------*)
  245.  
  246. procedure CalcVinkel;
  247. begin
  248.     sin1:=sinustabel[v1]; cos1:=sinustabel[v1+128];
  249.     sin2:=sinustabel[v2]; cos2:=sinustabel[v2+128];
  250.     sin3:=sinustabel[v3]; cos3:=sinustabel[v3+128];
  251.     v1:=(v1+2) AND 511;
  252.     v2:=(v2-1) AND 511;
  253.     v3:=(v3+1) AND 511;
  254. end;
  255.  
  256. procedure RotateAllCoords; assembler;
  257. {really fast assembly rotating around all three axis + perspective
  258.  calculations. Takes an coord. array, coords, and puts rotated coords
  259.  in cbuffer (only x,y are stored...)}
  260. asm
  261.     mov    ax,ds
  262.     mov    es,ax
  263.     lea    si,coords
  264.     lea    di,cbuffer
  265.     mov    n,ANTAL_COORDS
  266.     cld
  267. @loop:
  268.     lodsw
  269.     mov    xkoord,ax
  270.     lodsw
  271.     mov    ykoord,ax
  272.     lodsw
  273.     mov    zkoord,ax
  274.  
  275.     mov    ax,xkoord               {rotate around Z-axis}
  276.     push    ax
  277.     imul    Cos1
  278.     add    ax,ax
  279.     adc    dx,dx
  280.     mov    bx,dx
  281.     mov    ax,ykoord
  282.     imul    Sin1
  283.     add    ax,ax
  284.     adc    dx,dx
  285.     sub    bx,dx
  286.     mov    xkoord,bx
  287.     pop    ax
  288.     imul    Sin1
  289.     add    ax,ax
  290.     adc    dx,dx
  291.     mov    bx,dx
  292.     mov    ax,ykoord
  293.     imul    Cos1
  294.     add    ax,ax
  295.     adc    dx,dx
  296.     add    bx,dx
  297.     mov    ykoord,bx
  298.  
  299.     mov    ax,ykoord               {rotate around Y-axis}
  300.     push    ax
  301.     imul    Cos2
  302.     add    ax,ax
  303.     adc    dx,dx
  304.     mov    bx,dx
  305.     mov    ax,zkoord
  306.     imul    Sin2
  307.     add    ax,ax
  308.     adc    dx,dx
  309.     sub    bx,dx
  310.     mov    ykoord,bx
  311.     pop    ax
  312.     imul    Sin2
  313.     add    ax,ax
  314.     adc    dx,dx
  315.     mov    bx,dx
  316.     mov    ax,zkoord
  317.     imul    Cos2
  318.     add    ax,ax
  319.     adc    dx,dx
  320.     add    bx,dx
  321.     mov    zkoord,bx
  322.  
  323.     mov    ax,xkoord               {rotate around X-axis}
  324.     push    ax
  325.     imul    Cos3
  326.     add    ax,ax
  327.     adc    dx,dx
  328.     mov    bx,dx
  329.     mov    ax,zkoord
  330.     imul    Sin3
  331.     add    ax,ax
  332.     adc    dx,dx
  333.     sub   bx,dx
  334.     mov    xkoord,bx
  335.     pop    ax
  336.     imul    Sin3
  337.     add    ax,ax
  338.     adc    dx,dx
  339.     mov    bx,dx
  340.     mov    ax,zkoord
  341.     imul    Cos3
  342.     add    ax,ax
  343.     adc    dx,dx
  344.     add    bx,dx
  345.     mov    zkoord,bx
  346.  
  347.     add    bx,800
  348.     and    bx,bx
  349.     jnz    @zero
  350.     mov    bl,1
  351. @zero:
  352.  
  353.     mov        ax,xkoord
  354.     cwd
  355.     mov        dl,ah
  356.     mov        ah,al
  357.     xor        al,al
  358.     idiv        bx
  359.     add        ax,160
  360.     stosw
  361.  
  362.     mov        ax,ykoord
  363.     cwd
  364.     mov        dl,ah
  365.     mov        ah,al
  366.     xor        al,al
  367.     idiv        bx
  368.     add        ax,100
  369.     stosw
  370.  
  371.     dec        n
  372.     jne        @loop
  373. end;
  374.  
  375.  
  376.  
  377. function FaceShown(i : integer; l1,l2,l3 : byte) : boolean;
  378. var
  379.     a,b : longint;
  380. begin
  381.     a := longmul(cbuffer[l1]-cbuffer[l2],cbuffer[l3+1]-cbuffer[l2+1]);
  382.     b := longmul(cbuffer[l1+1]-cbuffer[l2+1],cbuffer[l3]-cbuffer[l2]);
  383.     light[i] := longdiv(a-b,200);
  384.     FaceShown := (a-b) > 0;
  385. end;
  386.  
  387.  
  388. procedure FillShape(y,ysize : integer; color : byte); assembler;
  389. const
  390.     pixelarray1 : array[0..3] of byte = (0,14,12,8);
  391.     pixelarray2 : array[0..3] of byte = (0,1,3,7);
  392. asm
  393.     cmp    ysize,200
  394.     jae    @done
  395.     mov    ax,y
  396.     add    ax,ax
  397.     mov    si,ax
  398.     mov    di,[si+OFFSET ytabel]
  399.     add    di,display1
  400.     lea    si,slope
  401.     add    ax,ax
  402.     add    si,ax
  403.  
  404.     mov    es,SEGA000
  405.     mov    bl,color                                { color in BL }
  406.     {doing this outside is a bit risky}
  407.     mov    dx,$3C4
  408.     mov    al,$02
  409.     out    dx,al
  410.     {set dir.flag}
  411.     cld
  412. @yloop:
  413.     lodsw
  414.     mov    dx,ax
  415.     lodsw
  416.     cmp    ax,dx
  417.     jle    @exchange
  418.     xchg    ax,dx
  419. @exchange:
  420.  
  421.     cmp    dx,0
  422.     jl        @filledout_fast
  423.     cmp    ax,320
  424.     jge    @filledout_fast
  425.     cmp    ax,0
  426.     jge    @cut1
  427.     xor    ax,ax
  428. @cut1:
  429.     cmp    dx,319
  430.     jle    @cut2
  431.     mov    dx,319
  432. @cut2:
  433.     push    si
  434.     push    di
  435.  
  436.     mov    cx,dx
  437.     sub    dx,ax
  438.     mov    si,dx                                 { size in si at this moment... }
  439.  
  440.     mov    dx,ax                                    { get x pos }
  441.     shr    ax,2
  442.     add    di,ax
  443.     shr    cx,2
  444.  
  445.     cmp    ax,cx                                    { size is <= 4 if on same }
  446.     jne    @notsamebyte                        { byteoffset... special case }
  447.     mov    cx,si
  448.     and    cx,cx
  449.     jz        @filledout
  450.     mov    al,00001111b
  451.     dec    cl
  452.     xor    cl,3
  453.     shr    al,cl
  454.     mov    cl,dl
  455.     and    cl,3
  456.     shl    al,cl
  457.     mov    dx,$3C5
  458.     out    dx,al
  459.     mov    al,bl
  460.     stosb
  461.     jmp    NEAR PTR @filledout
  462. @notsamebyte:
  463.     mov    cx,si
  464.  
  465.     and    dx,3                                {start painting a line}
  466.     jz        @OnRightByte
  467.     mov    si,dx
  468.     mov    al,BYTE PTR pixelarray1+si
  469.     dec    dl
  470.     xor    dl,$03
  471.     sub    cx,dx
  472.     mov    dx,$3C5
  473.     out    dx,al
  474.     mov    al,bl
  475.     stosb
  476. @OnRightByte:
  477.  
  478.     mov    dx,$3C5
  479.     mov    al,$F
  480.     out    dx,al
  481.  
  482.     mov    al,bl
  483.  
  484.     mov    dx,cx
  485.     test    di,1                            {make sure we fill word on even boundary}
  486.     jz        @oneven                        {this check is actually worth it!}
  487.     cmp    dx,4
  488.     jl        @only4left
  489.     stosb
  490.     sub    dx,4
  491. @oneven:
  492.  
  493.     mov    cx,dx                            {fill as many words we can}
  494.     and    dx,7
  495.     shr    cx,3
  496.     jz        @only8left
  497.     mov    ah,al
  498.     rep stosw
  499. @only8left:
  500.  
  501.     test    dl,4                            {also fill a possible whole last-byte}
  502.     jz        @only4left
  503.     stosb
  504.     sub    dl,4
  505. @only4left:
  506.  
  507.     and    dl,dl                            {and also the last few pixels}
  508.     jz        @filledout
  509.     mov    si,dx
  510.     mov    dx,$3C5
  511.     mov    al,BYTE PTR pixelarray2+si
  512.     out    dx,al
  513.     mov    al,bl
  514.     stosb
  515.  
  516. @filledout:
  517.     pop    di
  518.     pop    si
  519. @filledout_fast:
  520.     add    di,WIDTH
  521.     dec    ysize
  522.     jnz    @yloop
  523. @done:
  524. end;
  525.  
  526.  
  527. procedure RunOnce;
  528. var
  529.     i : integer;
  530. begin
  531.     SwapDisplay;
  532.     VBLANK;
  533. {$IFDEF DEBUG}
  534.     SetRGB(0,30,0,0);
  535. {$ENDIF}
  536.  
  537.     for i:=1 to ANTAL_FACES do    setRGB(i,light[i],light[i],light[i]);
  538.  
  539.     ClearScreen(lastscrminy,lastscrmaxy);
  540.  
  541.     lastscrminy := scrminy; lastscrmaxy := scrmaxy;
  542.     scrminy := 200; scrmaxy := 0;
  543.  
  544.     CalcVinkel;
  545.     RotateAllCoords;
  546.  
  547.     for i:=1 to ANTAL_FACES do begin
  548.         with face[i] do if FaceShown(i, l1 shl 1,l2 shl 1,l3 shl 1) then begin
  549.             ClearSlope;
  550.             miny := 200; maxy := 0;
  551.             CalcSlope(l1,l2);
  552.             CalcSlope(l2,l3);
  553.             CalcSlope(l3,l4);
  554.             CalcSlope(l4,l1);
  555.             FillShape(miny, maxy-miny, i);
  556.             if (miny < scrminy) then scrminy := miny;
  557.             if (maxy > scrmaxy) then scrmaxy := maxy;
  558.         end;
  559.     end;
  560. {$IFDEF DEBUG}
  561.     SetRGB(0,0,0,0);
  562. {$ENDIF}
  563. end;
  564.  
  565.  
  566. begin
  567.     OpenScreen;
  568.     InitDemo;
  569.     SetAllInterrupts;
  570.     repeat RunOnce until Key='e';
  571.     RestoreAllInterrupts;
  572.     CloseScreen;
  573. end.
  574.